home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bonus.arc / SOLID-3D.LSP < prev    next >
Encoding:
Text File  |  1986-02-17  |  1.5 KB  |  52 lines
  1. (defun c:SOLID-3D ()
  2. (setvar "fillmode" 0)
  3. (setq pt1 (getpoint "first base point: "))
  4. (setq pt2 (getpoint "second base point: "))
  5. (setq pt3 (getpoint "third base point: "))
  6. (setq pt4 (getpoint "fourth base point (RETURN for 3-point base): "))
  7. (setq pt5 (getpoint "first top point: "))
  8. (setq pt6 (getpoint "second top point: "))
  9. (setq pt7 (getpoint "third top point: "))
  10. (if (/= pt4 nil) (setq pt8 (getpoint "fourth top point: ")))
  11. (setq h (getdist "height: "))
  12. (setq r (getint "step resolution: "))
  13. (setq t1 (getvar "thickness"))
  14. (setq e (getvar "elevation"))
  15. (setq e1 e)
  16. (setq t (setvar "thickness" (/ h r)))
  17. (setq a1 (angle pt1 pt5))
  18. (setq a2 (angle pt2 pt6))
  19. (setq a3 (angle pt3 pt7))
  20. (if (/= pt4 nil) (setq a4 (angle pt4 pt8)))
  21. (setq d1 (/ (distance pt1 pt5) r))
  22. (setq d2 (/ (distance pt2 pt6) r))
  23. (setq d3 (/ (distance pt3 pt7) r))
  24. (if (/= pt4 nil) (setq d4 (/ (distance pt4 pt8) r)))
  25. (defun B3 ()
  26. (command "SOLID" pt1 pt2 pt3 "" "")
  27. )
  28. (defun B4 ()
  29. (command "SOLID" pt1 pt2 pt3 pt4 "")
  30. )
  31. (if (/= pt4 nil) (b4) (b3))
  32. (defun STEP4 ()
  33. (setq e (setvar "elevation" (+ e t)))
  34. (setq pt1 (polar pt1 a1 d1))
  35. (setq pt2 (polar pt2 a2 d2))
  36. (setq pt3 (polar pt3 a3 d3))
  37. (setq pt4 (polar pt4 a4 d4))
  38. (command "SOLID" pt1 pt2 pt3 pt4 "")
  39. )
  40. (defun STEP3 ()
  41. (setq e (setvar "elevation" (+ e t)))
  42. (setq pt1 (polar pt1 a1 d1))
  43. (setq pt2 (polar pt2 a2 d2))
  44. (setq pt3 (polar pt3 a3 d3))
  45. (command "SOLID" pt1 pt2 pt3 "" "" )
  46. )
  47. (setq n (- r 1))
  48. (if (/= pt4 nil) (repeat n (step4)) (repeat n (step3)))
  49. (setvar "elevation" e1)
  50. (setvar "thickness" t1)
  51. )
  52.